home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
amsf20.zip
/
AMST4.FOR
< prev
next >
Wrap
Text File
|
1992-01-06
|
2KB
|
48 lines
C ******************************************************************
C * *
C * S O L V E *
C * *
C ******************************************************************
PROGRAM SOLVE
IMPLICIT INTEGER*4(I-N)
IMPLICIT REAL*8 (A-H,O-Z)
REAL*4 EPS
CHARACTER ANS*1
COMMON MAVAIL,IA(30000)
MAVAIL = 30000
C ... SOLVE SIMULTANEOUS LINEAR EQUATIONS AX=B
PRINT *,' '
PRINT *,'SIMULTANEOUS LINEAR EQUATIONS SOLVER: A X = B'
PRINT *,' '
PRINT *,'ENTER NUMBER OF EQUATIONS ? '
READ *, N
MODE = 0
PRINT *,'IS MATRIX A SYMMETRIC <Y/N> ?'
READ '(A)',ANS
IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') MODE=1
C ... TEST IN-CORE DATA MANAGEMENT
CALL DBOPEN(1,'TSTDAT.DAT','NEW')
CALL DEFINE(1,'A',0,1,N,N,MODE,NA)
CALL DEFINE(1,'B',0,1,N,1,0,NB)
PRINT *,'NOW ENTER THE MATRIX A'
CALL MATINP(1,'A')
PRINT *,'NOW ENTER THE RIGHT-HAND-SIDE VECTOR B'
CALL MATINP(1,'B')
C ... SOLVE BY IBM SSP ROUTINES DGELG AND DGELS
EPS = 1.0E-7
IF (MODE.EQ.0) THEN
CALL DGELG(IA(NB),IA(NA),N,1,EPS,INFO)
ELSE
CALL DEFINE(1,'AUX',0,1,N-1,1,0,IAUX)
CALL DGELS(IA(NB),IA(NA),N,1,EPS,INFO,IA(IAUX))
ENDIF
IF (INFO.NE.0) THEN
PRINT *,INFO,'-TH PIVOT IS ZERO.'
STOP
ENDIF
PRINT *,'THE SOLUTION VECTOR X'
CALL MATOUT(1,'B')
CALL DBCLOS(1,'DELETE')
STOP 'DONE.'
END